home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / comm / misc / mirrorman_1_10b1.lha / MirrorManager-1.10b1 / rexx / Demo.rexx < prev    next >
OS/2 REXX Batch file  |  1994-06-24  |  21KB  |  671 lines
  1. /*rx
  2. **
  3. **  $VER: $Id: Demo.rexx,v 1.9 1994/06/24 16:46:44 tf Exp $
  4. **
  5. **  This is a tutorial .rexx script demonstrating the powerful ARexx port
  6. **  of the MirrorManager GUI.  It is executable via RX and runs it's own
  7. **  MirrorManager host if needed.
  8. **
  9. **  MirrorManager is (C) Copyright 1994 by Harald Kunze and Tobias Ferber
  10. **
  11. **  Initial revision (hacked in a hurry) by Tobias Ferber, 27-Feb-94
  12. */
  13.  
  14. appstart = 'Run /MirrorManager'
  15. portbase = 'MIRRORMANAGER.'
  16. def_stacksize = 10240
  17. portlist = ""
  18.  
  19. options results
  20.  
  21. myname = whoami()
  22. args   = ""
  23. label  = ""    /* name of the procedure to be CALLed */
  24.  
  25. signal on HALT
  26. signal on BREAK_C
  27. signal on BREAK_D
  28.  
  29. call pragma('W','N')
  30.  
  31. if ~exists(myname) then do
  32.   if abbrev(address(),portbase) then do
  33.     REQUESTCHOICE TITLE   '"MirrorManager"',
  34.                   BODY    '"This tutorial script is nested deply*n' ||,
  35.                           'in your directory hierarchy...*n'        ||,
  36.                           'I''ve been unable to locate myself"',
  37.                   GADGETS '"Exit"'
  38.     end
  39.  
  40.   else if exists('c:requestchoice') then do
  41.     address command 'c:requestchoice >nil:',
  42.         'TITLE    "MirrorManager"',
  43.         'BODY     "This tutorial script seems to be nested deeply*n' ||,
  44.                   'in your directory hierarchy...*n'                 ||,
  45.                   'I''ve been unable to locate myself..."',
  46.         'GADGETS  "Exit"'
  47.     end
  48.  
  49.   else say 'MirrorManager is located too deep in your directory hierarchy...'
  50.   exit 10
  51.   end
  52.  
  53.  
  54. /* BEGIN BUGGY CALLING METHOD
  55.  
  56. if pos(' ',myname) > 0 then do
  57.   if abbrev(address(),portbase) then do
  58.     REQUESTCHOICE TITLE   '"MirrorManager WARNING"',
  59.                   BODY    '"The pathname of this tutorial script*n'  ||,
  60.                           'contains a space character...*n'          ||,
  61.                           'This might be a problem for ARexx !"',
  62.                   GADGETS '"We''ll see"'
  63.     end
  64.  
  65.   else if exists('c:requestchoice') then do
  66.     address command 'c:requestchoice >nil:',
  67.         'TITLE    "MirrorManager WARNING"',
  68.         'BODY     "The pathname of this tutorial script*n'   ||,
  69.                   'contains a space character...*n'          ||,
  70.                   'This might be a problem for ARexx !"',
  71.         'GADGETS  "We''ll see"'
  72.     end
  73.  
  74.   else do
  75.     say 'The pathname of this tutorial script contains a space character...'
  76.     say 'This might be a problem for ARexx !'
  77.     end
  78.  
  79.   end
  80.  
  81. END BUGGY CALLING METHOD */
  82.  
  83.  
  84. if arg() > 0 then do
  85.   portname= arg(1)
  86.   if abbrev(portname,portbase) then do
  87.     address(portname)
  88.     if arg() > 1 then do
  89.       label = upper( arg(2) )
  90.       do ac= 3 while ac <= arg()
  91.         args= args || '0a'x || arg(ac)
  92.         end
  93.       end
  94.     end
  95.   else do
  96.     say 'Usage:' myname '[ MIRRORMANAGER.<x> ] [label]'
  97.     exit
  98.     end
  99.   end
  100. else do
  101.   if ~abbrev(address(),portbase) then do
  102.  
  103. /***
  104.     if exists('c:requestchoice') then do
  105.       address command 'c:requestchoice >nil:',
  106.           'TITLE    "MirrorManager"',
  107.           'BODY     "This is a tutorial demo script.*n'            ||,
  108.                     'Please double-click the Configure icon*n'     ||,
  109.                     'in your MirrorManager/rexx drawer to*n'       ||,
  110.                     'setup MirrorManager for your system."',
  111.           'GADGETS  "Okay"'
  112.       end
  113. ***/
  114.  
  115.     portlist = SHOW('P',,'0A'X)
  116.     do while words(portlist) > 0
  117.       parse var portlist portname '0A'X portlist
  118.       if abbrev(portname,portbase) then do
  119.         address(portname); 'NUMENTRIES'
  120.         if result = 0 then portlist= ""
  121.                       else address
  122.         end
  123.       end
  124.  
  125.     if address() ~= portname then do
  126.       stacksize= pragma('S',def_stacksize)
  127.       address command appstart 'CONFIGNAME='transquote(myname)
  128.       call pragma('S',stacksize)
  129.       exit
  130.       end
  131.  
  132.     end
  133.   else do
  134.     portname= address()
  135.  
  136.     REQUESTCHOICE TITLE   '"MirrorManager"',
  137.                   BODY    '"This is a tutorial demo script.*n'       ||,
  138.                           'Please double-click the Configure icon*n' ||,
  139.                           'in your MirrorManager/rexx/ drawer to*n'  ||,
  140.                           'setup MirrorManager for your system."',
  141.                   GADGETS '"Okay"'
  142.     end
  143.   end
  144.  
  145. CONFIGNAME transquote(myname)
  146.  
  147. signal on ERROR
  148. signal on IOERR
  149.  
  150. signal on FAILURE
  151. /*signal on NOVALUE*/
  152. signal on SYNTAX
  153.  
  154. /* list of legal procedures */
  155. proctab= 'WELCOME:SCRIPTINFO:DRIVING:HAESSLICH:SHOWHELP:MOVEME:MMREQ:LOADCONFIG:APPINFO:'
  156.  
  157. IF (WORDS(label) > 0) THEN DO
  158.   IF (POS(label':',proctab) > 0) THEN INTERPRET 'CALL' label
  159.   ELSE DO
  160.     ESC= '1b'x
  161.     REQUESTCHOICE TITLE   '"Tutorial Demo"',
  162.                   BODY    '"Unrecognized keyword:*n*n'ESC'c'ESC'b'label || ESC'n'ESC'l"',
  163.                   GADGETS '"Hmmm..."'
  164.     CALL WELCOME
  165.     END
  166.   END
  167. ELSE CALL WELCOME
  168. EXIT
  169.  
  170.  
  171. WELCOME: procedure expose portname myname
  172.   clear; configname transquote(myname)
  173.   'MESSAGE CLOSE'
  174.   call scroll_item ('Welcome to MirrorManager')
  175.   call add_item    ('... your local Aminet mirror management system')
  176.   call add_item    ('')
  177.   call add_item    ('Please select one of the following items:')
  178.   call add_item    ('')
  179.  
  180.   add  '"» Show HELP on ARexx commands"'    transquote(myname)  '"' || portname 'SHOWHELP'   || '"'
  181.   add  '"» Display application INFO"'       transquote(myname)  '"' || portname 'APPINFO'    || '"'
  182.   add  '"» Get info on script files"'       transquote(myname)  '"' || portname 'SCRIPTINFO' || '"'
  183.   add  '"» Add a moving item"'              transquote(myname)  '"' || portname 'MOVEME'     || '"'
  184.   add  '"» Add a jumping item"'             transquote(myname)  '"' || portname 'MOVEME'     || '"'
  185.   add  '"» Go for a drive..."'              transquote(myname)  '"' || portname 'DRIVING'    || '"'
  186.   add  '"» Show fix-width font banner"'     transquote(myname)  '"' || portname 'HAESSLICH'  || '"'
  187.   add  '"» Have a MUI requester"'           transquote(myname)  '"' || portname 'MMREQ'      || '"'
  188.   add  '"» Load another configuration"'     transquote(myname)  '"' || portname 'LOADCONFIG' || '"'
  189.   configname; cname= result
  190.   add  '"» Restart this demo script"'       transquote(cname) portname
  191.  
  192.   return 0
  193.  
  194.  
  195. SCRIPTINFO: procedure expose portname myname args
  196.   ESC = '1B'x
  197.   if words(args) > 0 then do
  198.     parse var args '0a'x fname '0a'x fnote
  199.  
  200.     parse var fname . '.' suffix
  201.     if (upper(suffix) = 'REXX') | (upper(suffix) = 'MM') then call MSGCOMMENT('rexx/'fname)
  202.  
  203.     if words(fnote) > 0 then
  204.       requestchoice title   '"Information on ' || fname || '"',
  205.                     body    '"' || ESC'b' || fname || ESC'n' || ' has the following filenote:*n' ||,
  206.                                    ESC'c' || fnote || ESC'l"',
  207.                     gadgets '"Thank you"'
  208.  
  209.     else
  210.       requestchoice title   '"Information on ' || fname || '"',
  211.                     body    '"' || ESC'b' || fname || ESC'n' || ' has no filenote."',
  212.                     gadgets '"Sorry"'
  213.  
  214.     end
  215.   else do
  216.     clear; configname transquote(myname)
  217.     message clear; message open
  218.     tempfile= 't:items.' || pragma('Id')
  219.  
  220.     working '"Generating list of available script files..."'
  221.     complete 10
  222.  
  223.     address command 'list > "' || tempfile || '" files dir rexx lformat "%n;%c"'
  224.     complete 20
  225.  
  226.     if ~open('fp',tempfile,'r') then do
  227.       message '"Failed to create temprary file ' || tempfile || '"'
  228.       exit
  229.       end
  230.  
  231.     working '"Reading script file information..."'
  232.  
  233.     c= 30
  234.     do until eof('fp')
  235.       if c < 90 then do; complete c; c= c+2; end
  236.  
  237.       str= strip( readln('fp') )
  238.       if words(str) > 0 then do
  239.         parse var str fname ';' fnote
  240.         if words(fnote) > 0 then
  241.           add '"' || fname || '"' transquote(myname) '"' || portname 'SCRIPTINFO *"'fname'*" *"'fnote'*""'
  242.         else
  243.           add '"' || fname || ' (no filenote)"' transquote(myname) '"' || portname 'SCRIPTINFO *"'fname'*""'
  244.         end
  245.       end
  246.     call close('fp')
  247.  
  248.     complete 90
  249.     working '"Deleting temporary file..."'
  250.     address command 'delete quiet file' tempfile
  251.  
  252.     working '"Sorting MirrorManager ListView..."'
  253.     complete 95
  254.     sort
  255.  
  256.     add '"»»» Click here to return to MENU «««"' transquote(myname)   '"' || portname 'WELCOME' || '"'
  257.     working '"done.  Press the [HELP] key for more information..."'
  258.     complete 100
  259.     end
  260.  
  261.   return 0
  262.  
  263.  
  264.  
  265. DRIVING: procedure expose portname myname
  266.   w=10; i=5; c=100; call time('r')
  267.  
  268.   message clear; message open
  269.   working '"Driving...."'
  270.  
  271.   do r=0 for 5 by 5
  272.     do n=0 for r
  273.       complete c; c=c-1
  274.       add_item(copies(' ',i+n) '|' copies(' ',w) '¦' copies(' ',w) '|')
  275.       end
  276.     do n=1 for r
  277.       complete c; c=c-1
  278.       add_item( copies(' ',i+r-n) '|' copies(' ',w) '¦' copies(' ',w) '|')
  279.       end
  280.     i= i+1
  281.     end
  282.  
  283.   add '"»»» Click here to return to MENU «««"' transquote(myname) '"' || portname 'WELCOME' || '"'
  284.  
  285.   working '"done."'
  286.   complete 0
  287.  
  288.   requestchoice title   '"Driving Statistics..."',
  289.                 body    '"This drive took' time('e') 'seconds"',
  290.                 gadgets '"Okay"'
  291.   return 0
  292.  
  293.  
  294. HAESSLICH: procedure expose portname myname
  295.   clear; configname transquote(myname)                                                 ;message clear; message open
  296.   call add_item ('This is')
  297.   call add_item ('')
  298.   call add_item ('     MM   MM  ii                                 ')                  ;message '"              _   _   __                         "'
  299.   call add_item ('     MMM MMM                                     ')                  ;message '"             / \_/ \ /_/                         "'
  300.   call add_item ('     MMMMMMM  ii   rrrrr   rrrrr    oooo   rrrrr ')                  ;message '"            / \__/ /__   _____ _____ ______ _____"'
  301.   call add_item ('     MM M MM  ii   rr  rr  rr  rr  oo  oo  rr  rr')                  ;message '"           / /  / // /  / .__// .__// __  // .__/"'
  302.   call add_item ('     MM   MM  ii   rr      rr      oo  oo  rr    ')                  ;message '"          / /  / // /_ / /   / /   / /_/ // /    "'
  303.   call add_item ('     MM   MM  ii   rr      rr      oo  oo  rr    ')                  ;message '"         /_/  /_//___//_/   /_/   /_____//_/     "'
  304.   call add_item ('     MM   MM   ii  rr      rr       oooo   rr    ')
  305.   call add_item ('')
  306.   call add_item ('MM   MM                                                ')            ;message '"     _   _                                          "'
  307.   call add_item ('MMM MMM                                                ')            ;message '"    / \_/ \                                         "'
  308.   call add_item ('MMMMMMM   aaaa   nnnnn    aaaa    ggggg   eeee   rrrrr ')            ;message '"   / \__/ /______ ______ ______  ______ ______ _____"'
  309.   call add_item ('MM M MM      aa  nn  nn      aa  gg  gg  ee  ee  rr  rr')            ;message '"  / /  / // __  // __  // __  / / __  // ____// .__/"'
  310.   call add_item ('MM   MM   aaaaa  nn  nn   aaaaa  gg  gg  eeeeee  rr    ')            ;message '" / /  / // __  // / / // __  / / /_/ // __/_ / /    "'
  311.   call add_item ('MM   MM  aa  aa  nn  nn  aa  aa   ggggg  ee      rr    ')            ;message '"/_/  /_//_/ /_//_/ /_//_/ /_/ _\__  //_____//_/     "'
  312.   call add_item ('MM   MM   aaaaa  nn  nn   aaaaa      gg   eeee   rr    ')            ;message '"                             /_____/                "'
  313.   call add_item ('                                  gggg                 ')            ;message '"                                                    "'
  314.   call add_item ('')                                                                   ;message '"      ...YOUR Aminet mirror management system       "'
  315.   call scroll_item('       ...YOUR Aminet mirror management system')
  316.   call add_item ('')
  317.  
  318.   add '"»»» Click here to return to MENU «««"' transquote(myname) '"' || portname 'WELCOME' || '"'
  319.   return 0
  320.  
  321.  
  322. SHOWHELP: procedure expose portname myname
  323.   helpfile= 't:help'
  324.   working '"Generating help file...  Please wait..."'
  325.  
  326.   help helpfile
  327.  
  328.   if ~open('fp',helpfile,'r') then do
  329.     working '"HELP failed to create' helpfile '!"'
  330.     exit
  331.     end
  332.  
  333.   message clear; message open
  334.   do l=0 until eof('fp')
  335.     complete min(3*l,100)
  336.     message '"'translate(strip(readln('fp')),"'",'"')'"'
  337.     working '"reading line' l'"'
  338.     end
  339.  
  340.   call close('fp')
  341.  
  342.   working '"deleting temporary help file..."'
  343.   address command 'delete quiet file' helpfile
  344.   complete 100
  345.   working '"done.  Press the [HELP] key for more information..."'
  346.   return 0
  347.  
  348.  
  349. /*
  350.  *  Load a new configuration
  351.  */
  352.  
  353. LOADCONFIG: procedure expose portname myname
  354.   ESC = '1B'x
  355.   cwd= strip(pragma('D'),'B','"')
  356.   SIGNAL OFF ERROR
  357.   REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select a config file..."' NOICONS
  358.   SIGNAL ON ERROR
  359.   if (result ~= 'RESULT') then do
  360.     fname = result
  361.     if exists(fname) then do
  362.       parse var fname . '.' suffix
  363.  
  364.       if (upper(suffix) = 'REXX') | (upper(suffix) = 'MM') then do
  365.  
  366.         p= MAX( lastpos(':',fname), lastpos('/',fname) )
  367.         if p > 0 then f= substr(fname,p+1)
  368.                  else f= fname
  369.  
  370.         call MSGCOMMENT(fname)
  371.         REQUESTCHOICE TITLE   '"Tutorial Demo"',
  372.                       BODY    '"You are about to leave this tutorial demo for*n*n'  ||,
  373.                               ESC'c'ESC'b' || f || ESC'n'ESC'l*n*n'                 ||,
  374.                               'Everything you worked on so hard will be lost !*n'   ||,
  375.                               'Are you really sure that you can afford that risk ?"',
  376.                       GADGETS '"Yes"'
  377.         CLEAR
  378.         LOCK OFF
  379.         LOAD transquote(fname)
  380.         exit
  381.         end
  382.  
  383.       else do
  384.  
  385.         REQUESTCHOICE TITLE   '"Tutorial Demo -- Bad suffix' suffix'"',
  386.                       BODY    '"I''m afraid I will not execute any configuration script*n'             ||,
  387.                               'with a suffix other than either' ESC'b.rexx'ESC'n or' ESC'b.mm'ESC'n*n' ||,
  388.                               'from within this tutorial demo!"',
  389.                       GADGETS '"Forget about it"'
  390.         end
  391.  
  392.       end
  393.  
  394.     else do
  395.       REQUESTCHOICE TITLE   '"Tutorial Demo"',
  396.                     BODY    '"Selected config script does not exist:*n' ||,
  397.                             ESC'c'ESC'b' || fname || ESC'n'ESC'l'       || '"',
  398.                     GADGETS '"Resume"'
  399.       end
  400.  
  401.     end
  402.   return 0
  403.  
  404.  
  405. /*
  406.  *  handle moving items
  407.  */
  408.  
  409. MOVEME: procedure expose portname myname
  410.   activate; select
  411.     when word(result,4) = 'moving'  then add '"« move-up »"'  transquote(myname) '"'portname 'MOVEME"'
  412.     when word(result,4) = 'jumping' then add '"« jump-top »"' transquote(myname) '"'portname 'MOVEME"'
  413.  
  414.     when result = '« move-up »'   then do;
  415.       up
  416.       if result < 1 then rename '"« move-down »"'
  417.       end
  418.  
  419.     when result = '« move-down »' then do
  420.       numentries; last= result
  421.       down
  422.       if result >= last-1 then rename '"« move-up »"'
  423.       end
  424.  
  425.     when result = '« jump-top »'    then do; top;     rename '"« jump-bottom »"';  end
  426.     when result = '« jump-bottom »' then do; bottom;  rename '"« jump-top »"';     end
  427.  
  428.     otherwise rename '"??? Did you rename me ???"'
  429.     end
  430.   return 0
  431.  
  432.  
  433. /*
  434.  *  Demonstrate MUI's text engine
  435.  */
  436.  
  437. MMREQ: procedure
  438.   ESC = '1b'x
  439.   NL  = '*n'
  440.  
  441.   RequestChoice TITLE    '"MirrorManager Request"',
  442.                 BODY     '"'                                            ||,
  443.                          '... using MUI''s powerful text engine'  || NL ||,
  444.                          ESC'c'                                   || NL ||,
  445.                          ESC'u' || 'underlined' || ESC'n'         || NL ||,
  446.                          ESC'b' || 'bold'       || ESC'n'         || NL ||,
  447.                          ESC'i' || 'italic'     || ESC'n'         || NL ||,
  448.                                                                      NL ||,
  449.                          ESC'r' || 'right justified'              || NL ||,
  450.                          ESC'l' || 'left justified'                     ||,
  451.                          '"',
  452.                 GADGETS  '"'date('w')'|'date('n')'|'time('n')'"'
  453.  
  454. /*
  455.                          ESC'I' || '3:mui-xenknob.image'          || NL ||,
  456.                          ESC'I' || '5:xtras/MirrorManager.brush'        ||,
  457. */
  458.  
  459.   return 0
  460.  
  461.  
  462. /*
  463.  *  Show application information
  464.  */
  465.  
  466. APPINFO: procedure
  467.   ESC = '1b'x
  468.   NL  = '*n'
  469.  
  470.   MESSAGE CLEAR; MESSAGE OPEN; WORKING '"Reading Application information ..."'
  471.  
  472.   COMPLETE  0; 'INFO Title';       MESSAGE transquote("Title......: " result)  /* Application title      */
  473.   COMPLETE 15; 'INFO Author';      MESSAGE transquote("Author.....: " result)  /* Author of the  applic  */
  474.   COMPLETE 30; 'INFO Copyright';   MESSAGE transquote("Copyright..: " result)  /* Copyright message      */
  475.   COMPLETE 45; 'INFO Description'; MESSAGE transquote("Description: " result)  /* Short description      */
  476.   COMPLETE 60; 'INFO Version';     MESSAGE transquote("Version....: " result)  /* Version string         */
  477.   COMPLETE 75; 'INFO Base';        MESSAGE transquote("Basename...: " result)  /* Name of the ARexx port */
  478.   COMPLETE 90; 'INFO Screen';      MESSAGE transquote("Screen.....: " result)  /* Name of the pub screen */
  479.  
  480.   COMPLETE 100; WORKING '"Application information"'
  481.   return 0
  482.  
  483.  
  484. /*
  485.  *  This procedure prints the first ARexx comment in the given file to the
  486.  *  Message window.  Nested comments ARE supported.
  487.  */
  488.  
  489. MSGCOMMENT: procedure
  490.   parse arg fname
  491.   if open('fp',fname,'R') then do
  492.     n= 0;
  493.     MESSAGE CLEAR; MESSAGE OPEN
  494.     WORKING '"'fname'"'
  495.  
  496.     do while (n=0) & ~eof('fp')
  497.       line= readln('fp')
  498.       n= count('/*',line)
  499.       end
  500.  
  501.     do while (n>0) & ~eof('fp')
  502.       MESSAGE transquote(line)
  503.       n= n - count('*/',line)
  504.       if n>0 then do
  505.         line= readln('fp')
  506.         n= n + count('/*',line)
  507.         end
  508.       end
  509.  
  510.     call close('fp')
  511.     end
  512.   return 0
  513.  
  514.  
  515. /*
  516. **  FUNCTIONS OF GENERAL USE
  517. */
  518.  
  519. /* translate '"' into '*"' and '*' into '**' */
  520.  
  521. transquote: procedure
  522.   parse arg s
  523.   t= s
  524.   q= max( lastpos('*',s), lastpos('"',s) )
  525.  
  526.   do while q > 0
  527.     t= insert('*',t,q-1,1)
  528.     s= left(s,q-1)
  529.     q= max( lastpos('*',s), lastpos('"',s) )
  530.     end
  531.  
  532.   return '"' || t || '"'
  533.  
  534.  
  535. /* counts the occurences of t in s */
  536.  
  537. count: procedure
  538.   parse arg t,s
  539.   n=0; p=0;
  540.   do while p>=0
  541.     p= pos(t,s,p+1)
  542.     if p>0 then n=n+1
  543.            else p=p-1
  544.     end
  545.   return n;
  546.  
  547.  
  548. /* add an item -- character by character */
  549.  
  550. scroll_item: procedure expose portname
  551.   parse arg str
  552.   call add_item(' ')
  553.   do l=1 for length(str)
  554.     RENAME '"' || right(str,l) || '"'
  555.     call wait .1
  556.     end
  557.   return 0
  558.  
  559.  
  560. /* add a no-op item */
  561.  
  562. add_item: procedure expose portname
  563.   parse arg s
  564.   t= ""
  565.   q= pos('"',s)
  566.   if q > 0 then do while q > 0
  567.     t= t || left(s,q-1) || '*"'
  568.     s= delstr(s,1,q)
  569.     q= pos('"',s)
  570.     end
  571.  
  572.   add '"' || t || s || '"' '"*"address ''' || portname || ''' requestchoice',
  573.                            'title ''*"*"Information...*"*"''',
  574.                            'body ''*"*"Clicking this item is a'' ''1B''x''bno-op''||''1B''x''n !*"*"''',
  575.                            'gadgets ''*"*"Hmmm...*"*"''"'
  576.   return 0
  577.  
  578.  
  579. /* celibrate a delay loop */
  580.  
  581. wait: procedure
  582.   arg delay
  583.   call time('r')
  584.   do while(time('e') < delay)
  585.     nop
  586.   end
  587.   return 0
  588.  
  589.  
  590. /* resolve the scriptfile name of THIS .rexx script */
  591.  
  592. whoami: procedure
  593.   parse source . . s
  594.   t= left(s,lastpos(':',s))
  595.  
  596.   called= strip( left(t,lastpos(' ',t)) )
  597.   call pragma('W','N')
  598.   do while ~exists(called) & lastpos(' ',called) > 0
  599.     called= left(called,lastpos(' ',called)-1)
  600.     end
  601.  
  602.   host= address()
  603.   parse var s (called) s (host) .
  604.   resolved= strip(s)
  605.  
  606.   call pragma('W','N')
  607.   do while ~exists(resolved)
  608.     resolved= left(resolved,lastpos(' ',resolved)-1)
  609.     end
  610.  
  611.   return resolved
  612.  
  613.  
  614. /* error/break handling */
  615.  
  616. IOERR:
  617. ERROR:
  618.   err= rc
  619.   ESC = '1b'x
  620.  
  621.   signal off ERROR
  622.   signal off IOERR
  623.  
  624.   WORKING '"I/O problem trapped... Execution halted."'
  625.   MESSAGE '"I/O problem trapped... Execution halted."'
  626.  
  627.   REQUESTCHOICE TITLE   '"Tutorial Error Trap' err'"',
  628.                 BODY    '"There was a problem with external I/O in line' sigl '...*n' ||,
  629.                         ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                || '"',
  630.                 GADGETS '"I''ll better exit"'
  631.   EXIT 0
  632.  
  633.  
  634. FAILURE:
  635. NOVALUE:
  636. SYNTAX:
  637.   err= rc
  638.   ESC = '1b'x
  639.  
  640.   signal off FAILURE
  641.   signal off NOVALUE
  642.   signal off SYNTAX
  643.  
  644.   WORKING '"Internal problem trapped... Execution halted."'
  645.   MESSAGE '"Internal problem trapped... Execution halted."'
  646.  
  647.   REQUESTCHOICE TITLE   '"Tutorial Internal Error' err'"',
  648.                 BODY    '"We seem to have an internal problem in line' sigl '...*n' ||,
  649.                         ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'              || '"',
  650.                 GADGETS '"I''ll better exit"'
  651.   EXIT 0
  652.  
  653.  
  654. HALT:
  655. BREAK_C:
  656. BREAK_D:
  657.   signal off HALT
  658.   signal off BREAK_C
  659.   signal off BREAK_D
  660.  
  661.   WORKING '"Break signal trapped... Execution halted."'
  662.   MESSAGE '"Break signal trapped... Execution halted."'
  663.  
  664.   REQUESTCHOICE TITLE   '"Tutorial Break Trap"',
  665.                 BODY    '"Script execution halted."',
  666.                 GADGETS '"Stop"'
  667.   EXIT 0
  668.  
  669.  
  670. /* END */
  671.